home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / ppl4p10.zip / TERM.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-20  |  13KB  |  439 lines
  1. (**********************************************)
  2. (*                                            *)
  3. (*      TERM.PAS         JAN  1995            *)
  4. (*                                            *)
  5. (*  TERM is a simple terminal emulator which  *)
  6. (*  features  ASCII, XMODEM, XMODEM-CRC,      *)
  7. (*  XMODEM-1K, YMODEM, YMODEM-G, & ZMODEM     *)
  8. (*  file transfer.                            *)
  9. (*                                            *)
  10. (*  Do NOT select YMODEM-G when using a null  *)
  11. (*  modem cable unless you are certain that   *)
  12. (*  RTS & CTS are reversed -- which is        *)
  13. (*  usually not true.                         *)
  14. (*                                            *)
  15. (*  Remember that you cannot send or receive  *)
  16. (*  binary files with ascii protocol - this   *)
  17. (*  includes many word processor file formats *)
  18. (*  such as used by Wordstar.                 *)
  19. (*                                            *)
  20. (**********************************************)
  21. (*                                            *)
  22. (*  This program is donated to the Public     *)
  23. (*  Domain by MarshallSoft Computing, Inc.    *)
  24. (*  It is provided as an example of the use   *)
  25. (*  of the Personal Protocol Library.         *)
  26. (*                                            *)
  27. (**********************************************)
  28.  
  29.  
  30. (*       XMODEM & YMODEM variants
  31. **
  32. **  Protocol  OneKflag  NCGbyte  BatchFlag
  33. **
  34. **  XMODEM      False     NAK      False
  35. **  XMODEM-CRC  False     C        False
  36. **  XMODEM-1K   True      C        False
  37. **  YMODEM      True      C        True
  38. **  YMODEM-G    True      G        True
  39. *)
  40.  
  41. {$I DEFINES.PAS}
  42.  
  43. program term;
  44.  
  45. {$IFDEF SCRIPTS}
  46. uses config,si,hex_io,term_io,modem_io,xymodem,xypacket,amodem,crc16,crc32,zdate,zmodem,crt,PCL4P;
  47. {$ELSE}
  48. uses config,hex_io,term_io,modem_io,xymodem,xypacket,amodem,crc16,crt32,zdate,zmodem,crt,PCL4P;
  49. {$ENDIF}
  50.  
  51. Var (* globals *)
  52.   ResetFlag: Boolean;
  53.   BaudText : String;
  54.   Port     : Integer;
  55.   TxBufPtr : Pointer;
  56.   RxBufPtr : Pointer;
  57.   TxBufSeg : Integer;
  58.   RxBufSeg : Integer;
  59.  
  60.   procedure MyHalt( Code : Integer );
  61.   var
  62.      RetCode : Integer;
  63.   begin
  64.      if Code < 0 then SayError( Code,'Halting' );
  65.      if ResetFlag then RetCode := SioDone(Port);
  66.      writeln('*** HALTING ***');
  67.      Halt;
  68.   end;
  69.  
  70. (* main program *)
  71.  
  72. const
  73.   NAK = $15;
  74.   ATTN_CHAR  = $1a;
  75.   ABORT_CHAR = $18;
  76.   WrongBaud1 = 'Cannot recognize baud rate';
  77.   WrongBaud2 = 'Must be 300,600,1200,2400,4800,9600,19200,38400,57600, or 155200';
  78.  
  79. var  (* globals *)
  80.   c         : Char;
  81.   i         : Integer;
  82.   TraceFlag : Boolean;
  83.   Filename  : String;
  84.   ResultMsg : String;
  85.   Protocol  : Char;
  86.   BaudCode  : Integer;
  87.   RetCode   : Integer;
  88.   TheByte   : Char;
  89.   MenuMsg   : String;
  90.   GetNameMsg: String;
  91.   Text40    : String;
  92.   OneKflag  : Boolean;
  93.   NCGbyte   : Byte;
  94.   BatchFlag : Boolean;
  95.   Flag      : Boolean;
  96.   Version   : Integer;
  97.   TermChar  : Byte;
  98.   CharPace  : Integer;
  99.   Timeout   : Integer;
  100.   EchoFlag  : Boolean;
  101.   Streaming : Boolean;
  102.  
  103. procedure ShowStatus(Attn:Byte;Text:String);
  104. begin
  105.   WriteColMsg('COM'+chr($31+Port)+' '+BaudText+' '+Protocol+' [ ^'+chr($40+Attn)+' '+Text+' ]',1,29)
  106. end;
  107.  
  108. procedure SetProtocol;
  109. begin
  110.   WriteMsg('A)scii X)modem Y)modem Z)modem: ');
  111.   ReadMsg(ResultMsg,61,1);
  112.   c := UpCase(ResultMsg[1]);
  113.   case c of
  114.     'A': (* ASCII *)
  115.        begin
  116.          Protocol := 'A';
  117.          (* setup ascii parameters *)
  118.          TermChar := $18; (* CAN or control-X *)
  119.          CharPace := 1;   (* 1 tic (5.5 ms) inter-byte delay *)
  120.          Timeout := 7;    (* timeout after 7 seconds *)
  121.          EchoFlag := TRUE;(* local echo *)
  122.          WriteMsg('Protocol = ASCII');
  123.        end;
  124.     'X': (* XMODEM *)
  125.        begin
  126.          Protocol := 'X';
  127.          OneKflag := FALSE;
  128.          NCGbyte := NAK;
  129.          BatchFlag := FALSE;
  130.          WriteMsg('Protocol = XMODEM');
  131.        end;
  132.     'Y': (* YMODEM *)
  133.        begin
  134.          Protocol := 'Y';
  135.          OneKflag := TRUE;
  136.          NCGbyte := Ord('C');
  137.          BatchFlag := TRUE;
  138.          WriteMsg('Protocol = YMODEM');
  139.        end;
  140.     'Z': (* ZMODEM *)
  141.        begin
  142.          Protocol := 'Z';
  143.          WriteMsg('Protocol = ZMODEM');
  144.        end;
  145.   end; (* case *)
  146.   ShowStatus(ATTN_CHAR,'for Menu');
  147. end;
  148.  
  149. Procedure ReceiveTheFile;
  150. Var
  151.   Flag : Boolean;
  152. begin
  153.   ShowStatus(ABORT_CHAR,'aborts');
  154.   case Protocol of
  155.     'A': (* ASCII *)
  156.        begin
  157.          (* Ascii *)
  158.          Filename := '';
  159.          if NOT FetchName(FileName) then exit;
  160.          Flag := RxAscii(Port,Filename,TermChar,Timeout,EchoFlag);
  161.        end;
  162.     'X':
  163.        begin
  164.          Filename := '';
  165.          Flag := XmodemRx(Port,Filename,NCGbyte);
  166.        end;
  167.     'Y':
  168.        begin
  169.          Filename := '';
  170.          Flag := YmodemRx(Port,Filename,NCGbyte)
  171.        end;
  172.     'Z':
  173.        begin
  174.          Flag := ZmodemRx(Port,Filename,Streaming);
  175.        end;
  176.   end; {case}
  177.   ShowStatus(ATTN_CHAR,'for Menu');
  178. end; (* ReceiveTheFile *)
  179.  
  180. Procedure SendTheFile;
  181. Var
  182.   Flag : Boolean;
  183. begin
  184.   Filename := '';
  185.   if NOT FetchName(FileName) then exit;
  186.   ShowStatus(ABORT_CHAR,'aborts');
  187.   case Protocol of
  188.     'A': (* ASCII *)
  189.         Flag := TxAscii(Port,Filename,CharPace,TermChar,Timeout,EchoFlag);
  190.     'X': (* XMODEM *)
  191.         Flag := XmodemTx(Port,Filename,OneKflag);
  192.     'Y':  (* YMODEM *)
  193.         Flag := YmodemTx(Port,Filename,OneKflag);
  194.     'Z':  (* ZMODEM *)
  195.         Flag := ZmodemTx(Port,Filename,Streaming);
  196.   end {case};
  197.   ShowStatus(ATTN_CHAR,'for Menu');
  198. end; (* SendTheFile *)
  199. begin   (* main program *)
  200.   TraceFlag := False;
  201.   TextMode(BW80);
  202.   ClrScr;
  203.   Window(1,1,80,24);
  204.   ResetFlag := FALSE;
  205.   Protocol := 'X';
  206.   OneKflag := FALSE;
  207.   NCGbyte := NAK;
  208.   BatchFlag := FALSE;
  209.   MenuMsg := 'Q)uit P)rotocol S)end R)eceive T)race: ';
  210.   (* fetch PORT # from command line *)
  211.   if ParamCount < 2 then
  212.     begin
  213.       writeln('USAGE: "TERM <port> <baudrate> {script}" ');
  214.       halt;
  215.     end;
  216.   Val( ParamStr(1),Port, RetCode );
  217.   if RetCode <> 0 then
  218.     begin
  219.       writeln('Port must be 1 to 16');
  220.       Halt;
  221.     end;
  222.   (* COM1 = 0, COM2 = 1, etc. *)
  223.   Port := Port - 1;
  224.   BaudText := ParamStr(2);
  225.   BaudCode := MatchBaud(BaudText);
  226.   if BaudCode < 0 then
  227.     begin
  228.       writeln(WrongBaud1);
  229.       writeln(WrongBaud2);
  230.       halt;
  231.     end;
  232.   (* streaming serial I/O at 19200 & less *)
  233.   if BaudCode < Baud38400 then Streaming := True
  234.   else Streaming := False;
  235.   (* patch up status message *)
  236.   if (Port<COM1) or (Port>COM16) then
  237.     begin
  238.       writeln('Port must be 1 to 16');
  239.       Halt
  240.     end;
  241.  
  242.   (*** custom configuration: 4 port card
  243.   RetCode := SioIRQ(COM3,IRQ2);
  244.   RetCode := SioIRQ(COM4,IRQ2);
  245.   ***)
  246.  
  247.   (*** custom configuration: DigiBoard PC/8
  248.   RetCode := SioPorts(8,COM1,$140,DIGIBOARD);
  249.   RetCode := SioUART(Port,$100+8*Port) ;
  250.   if RetCode < 0 then MyHalt( RetCode );
  251.   RetCode := SioIRQ(Port,IRQ5) ;
  252.   if RetCode < 0 then MyHalt( RetCode );
  253.   ***)
  254.  
  255.   (*** custom configuration: BOCA board BB2016
  256.   RetCode := SioPorts(16,COM1,$107,BOCABOARD);
  257.   RetCode := SioUART(Port,$100+8*Port) ;
  258.   if RetCode < 0 then MyHalt( RetCode );
  259.   RetCode := SioIRQ(Port,IRQ5) ;
  260.   if RetCode < 0 then MyHalt( RetCode );
  261.   ***)
  262.  
  263.   (* setup 2K receive buffer *)
  264.   GetMem(RxBufPtr,2048+16);
  265.   RxBufSeg := Seg(RxBufPtr^) + ((Ofs(RxBufPtr^)+15) SHR 4);
  266.   RetCode := SioRxBuf(Port, RxBufSeg, SioBufCode);
  267.   if RetCode < 0 then MyHalt( RetCode );
  268.   (* setup 2K transmit buffer *)
  269.   GetMem(TxBufPtr,2048+16);
  270.   TxBufSeg := (Seg(TxBufPtr^)+1) + (Ofs(TxBufPtr^) SHR 4);
  271.   RetCode := SioTxBuf(Port, TxBufSeg, SioBufCode);
  272.   if RetCode < 0 then MyHalt( RetCode );
  273.   (* reset port *)
  274.   RetCode := SioReset(Port,BaudCode);
  275.   (* if error then try one more time *)
  276.   if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  277.   (* Was port reset ? *)
  278.   if RetCode <> 0 then
  279.     begin
  280.       writeln('Cannot reset COM',Port+1);
  281.       MyHalt( RetCode );
  282.     end;
  283.   (* Port successfully reset *)
  284.   ResetFlag := TRUE;
  285.   ClrScr;
  286.   (* show logon message *)
  287.   WriteLn('   -- TERM 02/20/95 --');
  288.   WriteLn;
  289.   Write('TX interrupts: ');
  290.   if SioInfo('I') = 0 then WriteLn('NO')
  291.   else WriteLn('YES');
  292.   Version := SioInfo('V');
  293.   WriteLn('      Library: ',Version SHR 4,'.',15 AND Version);
  294.   (* specify parity, # stop bits, and word length for port *)
  295.   RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  296.   if RetCode < 0 then MyHalt( RetCode );
  297.   RetCode := SioRxFlush(Port);
  298.   if RetCode < 0 then MyHalt( RetCode );
  299.   Write(' Flow control: ');
  300. {$IFDEF RTS_CTS_CONTROL}
  301.   (* enable RTS/CTS flow control *)
  302.   RetCode := SioFlow(Port,10*18);
  303.   WriteLn('YES');
  304. {$ELSE}
  305.   WriteLn('NO');
  306. {$ENDIF}
  307.   (* set FIFO level if have INS16550 *)
  308.   RetCode := SioFIFO(Port, LEVEL_8);
  309.   Write('   16550 UART: ');
  310.   if RetCode > 0 then WriteLn('YES')
  311.   else WriteLn('NO');
  312.   WriteLn;
  313.   (* set DTR & RTS *)
  314.   RetCode := SioDTR(Port,SetPort);
  315.   RetCode := SioRTS(Port,SetPort);
  316.  
  317. {$IFDEF AT_COMMAND_SET}
  318.   Write('Waiting for DSR');
  319.   repeat
  320.     if SioBrkKey OR KeyPressed then
  321.       begin
  322.         Write('Aborted by user...');
  323.         RetCode := SioDone(Port);
  324.         Halt
  325.       end;
  326.     Write('.');
  327.     SioDelay(18);
  328.   until (SioDSR(Port)>0);
  329.   WriteLn;
  330. {$ENDIF}
  331.  
  332. {$IFDEF RTS_CTS_CONTROL}
  333.   Write('Waiting for CTS');
  334.   repeat
  335.     if SioBrkKey OR KeyPressed then
  336.       begin
  337.         Write('Aborted by user...');
  338.         RetCode := SioDone(Port);
  339.         Halt
  340.       end;
  341.     Write('.');
  342.     SioDelay(18);
  343.   until (SioCTS(Port)>0);
  344.   WriteLn;
  345. {$ENDIF}
  346.  
  347. {$IFDEF AT_COMMAND_SET}
  348.   (* send initialization string to modem *)
  349.   Flag := ModemSendTo(Port,5,'!!AT E1 S7=60 S11=60 V1 X1 Q0!');
  350.   if ModemWaitFor(Port,100,FALSE,'OK') <> chr(0) then
  351.     begin
  352.       writeln; writeln('MODEM ready');
  353.     end
  354.   else writeln('WARNING: Expected OK not received');
  355. {$ENDIF}
  356.  
  357.  
  358. {$IFDEF SCRIPTS}
  359.   if ParamCount = 3 then
  360.   begin
  361.     RetCode := Script(Port,ParamStr(3), False );
  362.     if RetCode < 0 then SaySiErr(RetCode);
  363.   end;
  364. {$ENDIF}
  365.  
  366.   (* begin terminal loop *)
  367.   writeln;
  368.   writeln('Enter terminal loop:');
  369.   ShowStatus(ATTN_CHAR,'for Menu');
  370.   SetMsgCol(30);
  371.  
  372.   LowVideo;
  373.   while TRUE do
  374.     begin (* while TRUE *)
  375.       (* did user press Ctrl-BREAK ? *)
  376.       if SioBrkKey then
  377.         begin
  378.           writeln('User typed Ctl-BREAK');
  379.           RetCode := SioDone(Port);
  380.           Halt;
  381.         end;
  382.       (* BREAK signal ? *)
  383.       if SioBrkSig(Port,DETECT) > 0 then WriteMsg('BREAK detected');
  384.       (* anything incoming over serial port ? *)
  385.       RetCode := SioGetc(Port,1);
  386.       if RetCode < -1 then MyHalt( RetCode );
  387.       if RetCode > -1 then write(chr(RetCode));
  388.       (* has user pressed a key ? *)
  389.       if KeyPressed then
  390.         begin (* keypressed *)
  391.           (* read keyboard *)
  392.           TheByte := ReadKey;
  393.           case TheByte of
  394.             chr($02):
  395.               begin
  396.                 (* send a BREAK *)
  397.                 WriteMsg('Sending BREAK');
  398.                 RetCode := SioBrkSig(Port,ASSERT);
  399.                 SioDelay(5);
  400.                 RetCode := SioBrkSig(Port,CANCEL);
  401.               end;
  402.             chr(ATTN_CHAR):
  403.               begin
  404.                 WriteMsg(MenuMsg);
  405.                 ResultMsg[1] := chr(0);
  406.                 ReadMsg(ResultMsg,68,1);
  407.                 c := UpCase(ResultMsg[1]);
  408.                 case c of
  409.                   'Q':  (* QUIT *)
  410.                      begin
  411.                        WriteLn;
  412.                        WriteLn('TERMINATING: User pressed <ESC>');
  413.                        RetCode := SioDone(Port);
  414.                        Halt;
  415.                      end;
  416.                   'T':  (* Trace *)
  417.                      begin
  418.                        TraceFlag := NOT TraceFlag;
  419.                        MsgEcho(TraceFlag);
  420.                        WriteBoolMsg('Trace is ',TraceFlag);
  421.                      end;
  422.                   'P': SetProtocol;
  423.                   'S': SendTheFile;
  424.                   'R': ReceiveTheFile;
  425.                   chr($0): {null}
  426.                 else WriteMsg('Bad response');
  427.                 end {case}
  428.               end (* ESC *)
  429.             else (* case *)
  430.               begin
  431.                 (* send out over serial line *)
  432.                 RetCode := SioPutc(Port, TheByte );
  433.                 if RetCode < 0 then MyHalt( RetCode );
  434.               end
  435.             end {case}
  436.         end (* keypressed *)
  437.       end (* while TRUE *)
  438. end.
  439.